home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 3: The Continuation / 17-Bit_The_Continuation_Disc.iso / arug / arug 29 / r4 < prev    next >
Text File  |  1994-01-27  |  20KB  |  800 lines

  1. 'Questo programma sperimentale per pk232 e Amiga creato da I0GO
  2. 'nella presente versione 1.2 est di libero uso
  3. 'fare attenzione a personalizzare le varie linee con il proprio
  4. 'nominativo,qth,nome,estremi del log etc. ad esempio su 
  5. 'mo16,mo17,mo18,rt17,rt18,lo3,lo4,lo5,kss,kssb,.... 
  6. 'Alcune funzioni non sono ancora abilitate.                                                                                                                                        
  7.  
  8. inizio:      
  9.  CLEAR ,50000&,9000
  10.  
  11.  PRINT:PRINT:PRINT "    Spegnere il pk 232 !!!!!!! "
  12.  PRINT:INPUT"      A=Alta risoluzione  R=SYSTEM  enter=inizio programma ",wx$
  13.  IF UCASE$(wx$)="A"THEN GOTO inizoo
  14.  IF UCASE$(wx$)="R" THEN SYSTEM
  15.  SCREEN 2,640,250,2,2
  16.  WINDOW 2, "COMUA V1.2 per pk 232" ,,24,2:GOTO inizoa
  17. inizoo:
  18.  SCREEN 2,640,500,2,4
  19.  WINDOW 2, "COMUA V1.2 per pk 232" ,,24,2
  20. inizoa:
  21.  GOSUB mese:WIDTH 79,20        
  22. inpi:
  23. REM: GOTO ilmenu
  24.  
  25.  
  26. apri: 
  27.  fi$="COMLOG"
  28.  OPEN fi$ AS #4 LEN=61
  29.  FIELD #4,10 AS d$,8 AS o$,10 AS c$,7 AS r$,13 AS q$,9 AS n$,4 AS f$
  30. dpsav:                   
  31.  FOR j%=1 TO 500:GET #4,j%:IF MID$(o$,1,1)="*"THEN LET k%=j%:GOTO indice
  32.  NEXT j%
  33. indice:
  34.  IF k% < 4 THEN GOSUB nonce
  35.  LOCATE 1,1:CLS
  36.  PRINT :PRINT "        ATTENDERE   !!!!!!!!!"
  37.  
  38.  GOSUB altro
  39.  adt$=STR$(VAL(dt$)-300):adt$=MID$(adt$,2,6)
  40.  
  41. ilmenu:
  42.   
  43.   MENU 1,0,1,"Packet"
  44.   MENU 1,1,1,"Packet"
  45.   MENU 1,2,1,"Vhf on"
  46.   MENU 1,3,1,"Vhf off"
  47.   MENU 1,4,1,"Connect"
  48.   MENU 1,5,1,"Disconn"
  49.   MENU 1,6,1,"Mheard"
  50.   MENU 1,7,1,"Cstatus"
  51.   MENU 1,8,1,"cmd:    "
  52.   MENU 1,9,1,"Monit1"
  53.   MENU 1,10,1,"Monit4"
  54.   MENU 1,11,1,"Monit6"
  55.   MENU 1,12,1,"Monit"
  56.   MENU 1,13,1,"Trcon"
  57.   MENU 1,14,1,"Trcoff"
  58.   MENU 1,15,1,"Daytime"
  59.   MENU 1,16,1,"Msg in"
  60.   MENU 1,17,1,"Msg out"
  61.   MENU 1,18,1,"Pass off"
  62.   MENU 1,19,1,"Pass on"
  63.   
  64.   MENU 2,0,1," Rtty"
  65.   MENU 2,1,1,"Baudot"
  66.   MENU 2,2,1,"Ascii "
  67.   MENU 2,3,1,"Rev on "
  68.   MENU 2,4,1,"Rev off"
  69.   MENU 2,5,1,"Wide on"
  70.   MENU 2,6,1,"Wide off"
  71.   MENU 2,7,1,"Xmit    "
  72.   MENU 2,8,1,"Rcve    "
  73.   MENU 2,9,1,"Baud up"
  74.   MENU 2,10,1,"Baud dwn"
  75.   MENU 2,11,1,"Ab 150"
  76.   MENU 2,12,1,"Ab 200"
  77.   MENU 2,13,1,"Ab 300"
  78.   MENU 2,14,1,"Ab 600"
  79.   MENU 2,15,1,"Conv   "
  80.   MENU 2,16,1,"Mode ? "
  81.   MENU 2,17,1,"Hello  "
  82.   MENU 2,18,1,"Rig hr "
  83.   MENU 2,19,1,"Thanks "
  84.   
  85.   
  86.        
  87.   MENU 3,0,1,"Morse"
  88.   MENU 3,1,1,"Morse "
  89.   MENU 3,2,1,"Xmit   "
  90.   MENU 3,3,1,"Receive"
  91.   MENU 3,4,1,"Lock rx"
  92.   MENU 3,5,1,"Unlock"
  93.   MENU 3,6,1,"store ch"
  94.   MENU 3,7,1,"store off"
  95.   MENU 3,8,1,"Read answ"
  96.   MENU 3,9,1,"Send answ"
  97.   MENU 3,10,1,"Load buff"
  98.   MENU 3,11,1,"10 wpm  "
  99.   MENU 3,12,1,"15 wpm  "
  100.   MENU 3,13,1,"20 wpm  "
  101.   MENU 3,14,1,"25 wpm  "
  102.   MENU 3,15,1,"30 wpm  "
  103.   MENU 3,16,1,"Cq      "
  104.   MENU 3,17,1,"xx de k "
  105.   MENU 3,18,1,"Tk rs qt"
  106.   MENU 3,19,1,"risp a cq"
  107.   
  108.   MENU 4,0,1,"Facsimile"
  109.   MENU 4,1,1,"Facsimile"
  110.   MENU 4,2,1,"Faxn off"
  111.   MENU 4,3,1,"Faxn on"
  112.   MENU 4,4,1,"Lock    "
  113.   MENU 4,5,1,"Prc off"
  114.   MENU 4,6,1,"Prc on"
  115.   MENU 4,7,1,"Prf off"
  116.   MENU 4,8,1,"Prf on"
  117.   MENU 4,9,1,"Prout off"
  118.   MENU 4,10,1,"Prout on"
  119.   MENU 4,11,1,"Signal"
  120.   MENU 4,12,1,"Ok     "
  121.   MENU 4,13,1,"Binv u"
  122.   MENU 4,14,1,"Binv d"
  123.   MENU 4,15,1,"Run prog"
  124.                
  125.   MENU 5,0,1,"Amtor"
  126.   MENU 5,1,1,"Amtor"
  127.   MENU 5,2,1,"a"
  128.   MENU 5,3,1,"a"
  129.   MENU 5,4,1,"Arq"
  130.   MENU 5,5,1,"Alist"
  131.   MENU 5,6,1,"Fec"
  132.   MENU 5,7,1,"Achg"
  133.   MENU 5,8,1,"Conv"
  134.   MENU 5,9,1,"Xmit"
  135.   MENU 5,10,1,"Restart"
  136.   MENU 5,11,1,"Tc clear"
  137.   MENU 5,12,1,"a"
  138.   MENU 5,13,1,"a"
  139.   MENU 5,14,1,"a"
  140.   MENU 5,15,1,"a"
  141.        
  142.   MENU 6,0,1,"Parameters"
  143.   MENU 6,1,1,"Serial port"
  144.   MENU 6,2,1,"Special ch"
  145.   MENU 6,3,1,"Facsimile"
  146.   MENU 6,4,1,"Identificat"
  147.   MENU 6,5,1,"Link status"
  148.   MENU 6,6,1,"Monitor"
  149.   MENU 6,7,1,"Cw rtty amt"
  150.   MENU 6,8,1,"Timing"
  151.   MENU 6,9,1,"All All"
  152.   MENU 6,10,1,"Help   "
  153.   MENU 6,11,1,"CLS    "
  154.   MENU 6,12,1,"Rcve asc"
  155.   MENU 6,13,1,"Send asc"
  156.   MENU 6,14,1,"Echo on "
  157.   MENU 6,15,1,"Echo off"
  158.   MENU 6,16,1,"Close list"
  159.   MENU 6,17,1,"Run prog"
  160.   MENU 6,18,1,"System"
  161.   MENU 6,19,1,"Save prg"
  162.  
  163.   MENU 7,0,1,"My log  "
  164.   MENU 7,1,1,"Start time"
  165.   MENU 7,2,1,"Mode-fq   "
  166.   MENU 7,3,1,"Call      "
  167.   MENU 7,4,1,"Name      "
  168.   MENU 7,5,1,"Qth       "
  169.   MENU 7,6,1,"His Rst   "
  170.   MENU 7,7,1,"My Rst    "  
  171.   MENU 7,8,1,"End  time"
  172.   MENU 7,9,1,"Read line"
  173.   MENU 7,10,1,"Corr line"
  174.   MENU 7,11,1,"Save line"
  175.   MENU 7,12,1,"Dele line"
  176.   MENU 7,13,1,"59  59  "
  177.   MENU 7,14,1,"599 599  "
  178.   MENU 7,15,1,"Read log"
  179.   MENU 7,16,1,"Print log"
  180.   MENU 7,17,1,"Read file"
  181.   MENU 7,18,1,"Info     "
  182.   MENU 7,19,1,"List Ram "
  183.   
  184.   MENU ON:CLS:GOSUB tempo
  185.   PRINT :PRINT "      COMUA V1.2 di I0GO, G. Riera Via Tevere 15, 00198 ROMA, tel.858263"
  186.   PRINT:PRINT:INPUT"   Digitare * ret per inserire data su pk232 all' accensione o solo ret  ",wx$:IF wx$<>"*" THEN GOTO klin
  187.   OPEN"com1:1200,n,8,1" AS 1
  188.   PRINT:PRINT "         Accendere il pk 232  !!! "
  189.   PRINT:PRINT:PRINT :PRINT 
  190.   
  191. indata:
  192.   IF INKEY$="*"THEN GOSUB pa15:GOTO klin
  193.   LINE INPUT #1,indx$:IF indx$<>"Checksum $E3"THEN PRINT indx$: GOTO indata
  194.   GOSUB pa15
  195. klin:
  196.   CLOSE #1:OPEN"com1:1200,n,8,1,xon" AS 1
  197.   WHILE 1
  198.   WHILE LOC(1)<>0  
  199.   u$=INPUT$(1,1):COLOR 1:PRINT u$;:COLOR 1
  200.   IF fl%=1 THEN PRINT #3,u$;
  201.   ON MENU GOSUB cerca
  202.   WEND
  203.   i$=INKEY$:IF fl%=2 THEN i$=INPUT$(1,3)
  204.   IF i$<>""THEN COLOR 3:PRINT  #1,i$;:PRINT i$; 
  205.   IF fl%<>2 THEN GOTO klin1
  206.   IF EOF(3)=-1 THEN GOSUB chiude:fl%=0
  207. klin1:  
  208.   ON MENU GOSUB cerca
  209.   WEND
  210.  GOTO indice
  211. nw1:
  212.   WINDOW 3,"COMUA/Interact",(1,1)-(625,50),8,2
  213.   COLOR 3:WINDOW OUTPUT 3:RETURN
  214.  
  215. nw2:
  216.   WINDOW OUTPUT 2:COLOR 1:WINDOW CLOSE 3
  217.   RETURN
  218.  
  219. cerca:
  220.   me1=MENU(0):me2=MENU(1)
  221.   ON me1 GOSUB pack,rty,mor,fac,amt,para,mylog
  222.   RETURN
  223.  
  224. pack:
  225.  ON me2 GOSUB pa1,pa2,pa3,pa4,pa5,pa6,pa7,pa8,pa9,pa10,pa11,pa12,pa13,pa14,pa15,pa16,pa17,pa18,pa19
  226.  RETURN
  227.  
  228. rty:
  229.  ON me2 GOSUB rt1,rt2,rt3,rt4,rt5,rt6,rt7,rt8,rt9,rt10,rt11,rt12,rt13,rt14,rt15,rt16,rt17,rt18,rt19
  230.  RETURN 
  231.  
  232. mor:
  233.  ON me2 GOSUB mo1,mo2,mo3,mo4,mo5,mo6,mo7,mo8,mo9,mo10,mo11,mo12,mo13,mo14,mo15,mo16,mo17,mo18,mo19
  234.  RETURN
  235.  
  236. fac:
  237.  ON me2 GOSUB fa1,fa2,fa3,fa4,fa5,fa6,fa7,fa8,fa9,fa10,fa11,fa12,fa13,fa14,fa15
  238.  RETURN 
  239.  
  240. amt: 
  241.  ON me2 GOSUB am1,am2,am3,am4,am5,am6,am7,am8,am9,am10,am11,am12,am13,am14,am15
  242.  RETURN
  243.  
  244. para:
  245.  ON me2 GOSUB pr1,pr2,pr3,pr4,pr5,pr6,pr7,pr8,pr9,pr10,pr11,pr12,pr13,pr14,pr15,pr16,pr17,pr18,pr19
  246.  RETURN
  247.  
  248. mylog:
  249.  COLOR 3,0
  250.  ON me2 GOSUB lo1,lo2,lo3,lo4,lo5,lo6,lo7,lo8,lo9,lo10,lo11,lo12,lo13,lo14,lo15,lo16,lo17,lo18,lo19
  251.  COLOR 1,0:RETURN
  252.  
  253. pa1:
  254.   in$="PA":GOSUB trt:in$="hb 1200":GOTO trt
  255. pa2:
  256.   in$="V ON":GOSUB trs:in$="hb 1200":GOTO trs
  257. pa3:
  258.   in$="V OFF":GOSUB trs:in$="hb 300":GOTO trs
  259. pa4:
  260.   in$="C "+cal$:PRINT "Connetto: ";cal$:GOTO trt
  261. pa5:
  262.   in$="D":GOTO trt
  263. pa6:
  264.   in$="MH":GOTO trs
  265. pa7:
  266.   in$="CS":GOTO trs
  267. pa8:
  268.   in$="":GOTO trt
  269. pa9:
  270.   in$="M 1":GOTO trs
  271. pa10:
  272.   in$="M 4":GOTO trs
  273. pa11:
  274.   in$="M 6":GOTO trs
  275. pa12:
  276.   in$="M":GOTO trs
  277. pa13:
  278.   in$="TRAC ON":GOTO trs
  279. pa14:
  280.   in$="TRAC OFF":GOTO trs
  281. pa15:
  282.   GOSUB datai:in$="DA "+dz$:GOTO trs
  283. pa16:
  284.    COLOR 3,0:PRINT :INPUT"",mn$:COLOR 1,0:RETURN
  285. pa17:
  286.    in$=mn$:GOSUB c1:GOTO trs
  287. pa18:
  288.     in$="PASSA OFF":GOTO trs
  289. pa19:
  290.     in$="PASSA ON":GOTO trs
  291.     
  292.     
  293. rt1:
  294.   in$="BA":GOSUB trt:in$="RXR OFF":GOSUB trs:in$="RB 50":GOTO trs
  295. rt2:
  296.   in$="AS":GOTO trs
  297. rt3:
  298.   in$="RXR ON":GOTO trs
  299. rt4:
  300.   in$="RXR OFF":GOTO trs
  301. rt5:
  302.   in$="WI ON":GOTO trs
  303. rt6:
  304.   in$="WI OFF":GOTO trs
  305. rt7:
  306.   in$="X":GOTO trs
  307. rt8:
  308.   in$="R":GOTO trs
  309. rt9:
  310.   in$="RB U":GOTO trs
  311. rt10:
  312.   in$="RB D":GOTO trs
  313. rt11:
  314.   in$="AB 150":GOTO trs
  315. rt12:
  316.   in$="AB 200":GOTO trs
  317. rt13:
  318.   in$="AB 300":GOTO trs
  319. rt14:
  320.   in$="AB 600":GOTO trs
  321. rt15:
  322.   in$="conv":GOTO trs
  323. rt16:
  324.   in$="O":GOTO trs
  325. rt17:
  326.   in$="Hello  nice to contact you - name here Joe and qth Rome >>":GOSUB c1:GOTO trs
  327. rt18:
  328.   in$="Rig hr amiga 500  pk232 and ts 430 s >>":GOSUB c1:GOTO trs  
  329. rt19:
  330.   in$="Thanks for nice contact hope to meet you agn 73 >>":GOSUB c1:GOTO trs
  331.  
  332. mo1:
  333.   in$="MO":GOTO trt
  334. mo2:
  335.   in$="X":GOTO trt
  336. mo3:
  337.   in$="R":GOTO trt
  338. mo4:
  339.   in$="L":GOTO trt
  340. mo5:
  341.   in$="MO":GOTO trt
  342. mo6:
  343.   in$="K":GOTO trt
  344. mo7:
  345.   in$="MO":GOTO trt
  346. mo8:
  347.   in$="":GOTO trs
  348. mo9:
  349.   in$="":GOTO trs
  350. mo10:
  351.   in$="":GOTO trs
  352. mo11:
  353.   in$="MSP 10":GOTO trt
  354. mo12:
  355.   in$="MSP 15":GOTO trt
  356. mo13:
  357.   in$="MSP 20":GOTO trt
  358. mo14:
  359.   in$="MSP 25":GOTO trt
  360. mo15:
  361.   in$="MSP 30":GOTO trt
  362. mo16:
  363.    GOSUB mo2:in$="cq cq cq de i0go i0go i0go  "
  364.    in$=in$+in$+in$+" + pse k ":GOSUB c1:GOTO trs
  365. mo17:   
  366.     GOSUB mo2:in$=cal$+" "+cal$+" de i0go  i0go i0go   pse  k"
  367.     GOSUB c1:GOTO trs
  368. mo18:
  369.     GOSUB mo2:in$=cal$+" de i0go - ok dr "
  370.     IF nam$="" THEN LET nam$="om"
  371.     in$=in$+nam$+" tks for rprt fm "
  372.     IF qth$="" THEN LET qth$="your qth "
  373.     in$=in$+qth$+" - ur rst "+hrs$+" "+hrs$
  374.     in$=in$+" - here name is joe joe es qth roma roma - rig amiga500 pk232 ts430s - ant dipole - ok ? "
  375.     in$=in$+cal$+" de i0go + k":GOSUB c1:GOTO trs    
  376. mo19:
  377.     GOSUB mo2:in$=cal$+" de i0go - tks fer call "
  378.     in$=in$+"ur rst "+hrs$+" "+hrs$
  379.     in$=in$+" - here name is joe joe es qth roma roma - rig amiga500 pk232 ts430s - ant dipole - ok ? "
  380.     in$=in$+cal$+" de i0go + k":GOSUB c1:GOTO trs    
  381.  
  382.  
  383. fa1:
  384.   in$="FA":GOTO trt
  385. fa2:
  386.   in$="FAXN OFF":GOTO trs
  387. fa3:
  388.   in$="FAXN ON":GOTO trs
  389. fa4:
  390.   in$="L":GOTO trs
  391. fa5:
  392.   in$="PRC OFF":GOTO trs
  393. fa6:
  394.   in$="PRC ON":GOTO trs
  395. fa7:
  396.   in$="PRF OFF":GOTO trs
  397. fa8:
  398.   in$="PRF ON":GOTO trs
  399. fa9:
  400.   in$="PRO OFF":GOTO trs
  401. fa10:
  402.   in$="PRO ON":GOTO trs
  403. fa11:
  404.   in$="SIGNAL":GOTO trs
  405. fa12:
  406.   in$="OK":GOTO trs
  407. fa13:
  408.   in$="BI U":GOTO trs
  409. fa14:
  410.   in$="BI D":GOTO trs
  411. fa15:
  412.   RUN:REM:in$="":GOTO trs
  413.  
  414. am1:
  415.   in$="AM":GOTO trt
  416. am2:
  417.   in$="":GOTO trs
  418. am3:
  419.   in$="":GOTO trs
  420. am4:
  421.   in$="AR":GOTO trs
  422. am5:
  423.   in$="AL":GOTO trs
  424. am6:
  425.   in$="FE":GOTO trs
  426. am7:
  427.   in$="AC":GOTO trs
  428. am8:
  429.   in$="CONV":GOTO trs
  430. am9:
  431.   in$="X":GOTO trs
  432. am10:
  433.   in$="RESTART":GOTO trs
  434. am11:
  435.   in$="TC":GOTO trs
  436. am12:
  437.   in$="":GOTO trs
  438. am13:
  439.   in$="":GOTO trs
  440. am14:
  441.   in$="":GOTO trs
  442. am15:
  443.   in$="":GOTO trs
  444.  
  445. pr1:
  446.   in$="DISP A":GOTO trs
  447. pr2:
  448.   in$="DISP C":GOTO trs
  449. pr3:
  450.   in$="DISP F":GOTO trs
  451. pr4:
  452.   in$="DISP I":GOTO trs
  453. pr5:
  454.   in$="DISP L":GOTO trs
  455. pr6:
  456.   in$="DISP M":GOTO trs
  457. pr7:
  458.   in$="DISP R":GOTO trs
  459. pr8:
  460.   in$="DISP T":GOTO trs
  461. pr9:
  462.   in$="DISP Z":GOTO trs
  463. pr10:
  464.   in$="H":GOTO trs
  465. pr11:
  466.   CLS:RETURN
  467. pr12:
  468.    IF fl%=1 THEN GOSUB chiude:fl%=0:RETURN
  469.    GOSUB apre:IF flx$="" THEN RETURN
  470.    CLOSE #3:OPEN flx$ FOR OUTPUT AS #3:PRINT " Ricevo il file ",flx$:fl%=1:RETURN
  471. pr13:
  472.     IF fl%=2 THEN GOSUB chiude:fl%=0:RETURN
  473.     GOSUB apre:IF flx$="" THEN RETURN
  474.     CLOSE #3:OPEN flx$ FOR INPUT AS #3:PRINT " Trasmetto file ", flx$:fl%=2:RETURN
  475. pr14:
  476.    in$="echo on":GOTO trs
  477. pr15:
  478.     in$="echo off":GOTO trs
  479. pr16:
  480.    MENU OFF:CLOSE:CLEAR:LIST:END
  481. pr17:
  482.    RUN
  483. pr18:
  484.    CLOSE:SYSTEM
  485. pr19:
  486.    SAVE "COMUA":SAVE"COMUA-A",A:RUN
  487. apre:
  488.    INPUT " Nome del file ? (ret=ret) 0-9 apre ram ",flx$:IF flx$="" THEN RETURN
  489.    IF ASC(flx$)<58 AND ASC(flx$)>47 THEN flx$="RAM:FILE"+flx$  
  490.    RETURN
  491. chiude:
  492.     CLOSE #3:PRINT:PRINT  " Ho chiuso il file ",flx$:RETURN
  493.   
  494.  
  495. lo1:
  496.    GOSUB datai:RSET d$=dz$
  497.    star$=MID$(DATE$,4,2)+"/"+MID$(DATE$,1,2)+"/"+MID$(DATE$,9,2)  
  498.    star$=star$+" "+MID$(TIME$,1,2)+MID$(TIME$,4,2):RETURN
  499.    in$="":GOTO trs
  500. lo2:
  501.    LINE INPUT;" Mode-fq p=144 pk ";mofq$:IF mofq$="p"THEN mofq$="144 Packet"
  502.    IF mofq$<>"" THEN LSET o$=UCASE$(mofq$)
  503.    RETURN
  504. lo3:
  505.   LINE INPUT;" Call g=go ";cal$:IF cal$="g" THEN cal$="I0go"
  506.   IF cal$<>"" THEN RSET c$=UCASE$(cal$)
  507.   RETURN
  508. lo4:
  509.   LINE INPUT;" Name ";nam$
  510.   IF nam$<>"" THEN RSET n$=UCASE$(nam$)
  511.   RETURN  
  512. lo5:  
  513.   LINE INPUT;" Qth r=Roma ";qth$:IF qth$="r" THEN qth$="Roma"
  514.   IF qth$<>"" THEN RSET q$=UCASE$(qth$)
  515.   RETURN
  516. lo6:
  517.   LINE INPUT;" His rst ";hrs$
  518.    RETURN
  519. lo7:
  520.   LINE INPUT;" My rst ";mrs$
  521. lo71:  
  522.    IF mrs$<>"" THEN RSET r$=mrs$+" "+hrs$:RETURN
  523. lo8:
  524.    sto$=MID$(TIME$,1,2)+MID$(TIME$,4,2)         
  525.    RSET f$=sto$:RETURN    
  526. lo9:
  527.   PRINT :GOSUB kas:RETURN
  528. lo10:
  529.    GOSUB elin:RETURN
  530. lo11:
  531.    GOSUB nw1:GOSUB kas:GOSUB prosi:RETURN
  532. lo12:
  533.    GOSUB nlin:RETURN
  534. lo13:
  535.    mrs$=" 59":hrs$=" 59":GOSUB lo71:RETURN
  536. lo14:
  537.    mrs$="599":hrs$="599":GOSUB lo71:RETURN
  538. lo15:
  539.    oub=0:GOSUB alin:RETURN
  540. lo16:
  541.    oub=1:GOSUB alin:RETURN
  542. lo17:
  543.    GOSUB apre:IF flx$="" THEN RETURN
  544.    CLOSE #3:OPEN flx$ FOR INPUT AS #3
  545. loop1:  
  546.    LINE INPUT #3,in$:PRINT in$:IF EOF(3)=-1 THEN GOSUB chiude:RETURN
  547.    GOTO loop1
  548. lo18:
  549.     GOSUB tempo:RETURN
  550. lo19:
  551.     FILES"RAM:":RETURN
  552.  
  553. trt:
  554.   in$=CHR$(3)+in$
  555. trs:
  556.    PRINT #1,in$:RETURN
  557.  
  558. datai:
  559.    dt$=MID$(DATE$,9,2)+MID$(DATE$,1,2)+MID$(DATE$,4,2)
  560.    dz$=dt$+MID$(TIME$,1,2)+MID$(TIME$,4,2)+MID$(TIME$,7,2)
  561.    RETURN
  562.  
  563. alin:
  564.  CLS:GOSUB chef:CLS:pag=1:pgg=1:GOSUB alio1
  565.  FOR j%=1 TO (k%-1):GET #4,j%
  566.  pag=(j%/70):IF pag>pgg THEN pgg=pgg+1: GOSUB alio2:k$="":GOSUB prs:k$="":GOSUB prs:k$="":GOSUB prs:GOSUB alio1
  567.  
  568.  
  569.  REM:IF x$="" AND d$ < adt$ THEN GOTO alio
  570.  GOSUB colo:GOSUB kas
  571. alio: 
  572.  IF MOUSE (0)=1 THEN RETURN
  573.  NEXT j%:GOSUB alio2:RETURN
  574. alio1:
  575.  GOSUB kss:GOSUB prs:k$="":GOSUB prs:GOSUB kssa:GOSUB prs 
  576.  RETURN
  577. alio2: 
  578.  k$="":GOSUB prs:GOSUB kssb:GOSUB prs
  579.  RETURN  
  580. blin:
  581.  CLS:FILES"df0:":INPUT"File da cancellare   ";x$:IF x$=""THEN GOTO indice 
  582.  LET x$="df0:"+x$:PRINT "cancello ";x$:KILL x$
  583.  GOTO indice
  584. clin:
  585.  CLS
  586.  GOTO indice
  587. dlin:
  588.  CLS:FILES"df0:":INPUT"File da caricare ?  p=prova ",x$:IF x$=""THEN GOTO indice
  589.  IF x$="p"THEN LET x$="prova"
  590.  CLOSE:LET x$="df0:"+x$:LOAD x$,r
  591. elin:
  592.  GOSUB nw1:INPUT"Record da correggere 0=ind ";j%
  593.  IF j%=0 THEN RETURN 
  594.  GET #4,j%:GOSUB kas
  595.  LINE INPUT "Datetime aammgghhmm ",dz$:IF dz$<>"" THEN RSET d$=dz$
  596.  GOSUB lo2:GOSUB lo3:GOSUB lo5
  597.  GOSUB lo4:GOSUB lo6:GOSUB lo7
  598.  LINE INPUT " End time ",sto$:IF sto$<>"" THEN RSET f$=sto$
  599.  GOSUB kas:PUT #4,j%:GOSUB nw2:RETURN
  600.  
  601.  
  602.  du$=d$:GOSUB corre
  603.  IF d$<>du$ THEN PUT #4,(k%+1):recc%=j%:FOR j%=recc% TO (k%+1):GET #4,(j%+1):PUT #4,j%:NEXT j%:k%=k%-1:GET #4,(k%+1):GOTO prosi                         
  604.  PUT #4,j%:GOSUB kas
  605.  GOTO elin
  606. flin:
  607.  CLS:FILES"df0:"
  608.  GOTO indx
  609. glin:
  610.  CLS:INPUT"Nome da Ricercare ";rx$:rx$=UCASE$(rx$):INPUT "segno - + ret ",ese$:INPUT "data iniz ggmmaa ",adata$:INPUT "data fine ggmmaa ",bdata$:GOSUB chef
  611.  tot#=0:CLS:GOSUB kss:GOSUB prs:k$=" "+gio$+" "+TIME$+"  PROG COGR  REV03 mar 88  ricerca:"+rx$:GOSUB prs:GOSUB kss:GOSUB prs
  612.  lena=LEN(adata$)+LEN(bdata$):IF lena<>12 THEN GOTO bglin
  613.  adata$=MID$(adata$,5,2)+MID$(adata$,3,2)+MID$(adata$,1,2):bdata$=MID$(bdata$,5,2)+MID$(bdata$,3,2)+MID$(bdata$,1,2)
  614. bglin: 
  615.  FOR j%=1 TO (k%-1):GET #4,j%
  616.  IF lena<>12 THEN GOTO aglin
  617.  IF d$ > bdata$ OR d$ < adata$ THEN GOTO doposeg
  618. aglin:
  619.  IF ese$="-" AND VAL(o$) > 0 THEN GOTO doposeg
  620.  IF ese$="+" AND VAL(o$) < 0 THEN GOTO doposeg
  621.  IF MID$(c$,1,(LEN(rx$)))=rx$ THEN tot#=tot#+VAL(o$):GOSUB colo:GOSUB kas
  622. doposeg:
  623.  NEXT j%:GOSUB kss:GOSUB prs:GOTO indx
  624.  GOTO indice
  625. hlin:
  626.  ba$="0":CLS
  627. calcu:
  628.  INPUT ca$: IF ca$=""THEN GOTO calco 
  629.  IF ca$="i"THEN GOTO indice
  630.  LET ba$=ca$
  631. calco:
  632.  x#=VAL(ba$):PRINT ba$;"=";x#
  633.  GOTO calcu
  634. ilin:
  635.  GOSUB nw1
  636. ilina: 
  637.  PRINT "record no.";k% 
  638.  GOSUB corre
  639. prosi:
  640.  PUT #4,k%:k%=(k%+1):du$=d$:GET #4,(k%-2):IF du$>=d$ THEN reco%=k%-1:GOTO prose
  641.  FOR j%=1 TO (k%-2):GET #4,j%:IF  d$>du$ THEN reco%=j%:GOTO prosa
  642.  NEXT j%
  643. prosa: 
  644.  FOR j%=k% TO reco% STEP -1
  645.  GET #4,j%:PUT #4,(j%+1)
  646.  NEXT j%:GET #4,(k%):PUT #4,reco% 
  647. prose: 
  648.  GET #4,reco%:j%=reco%:GOSUB kas
  649.  REM:INPUT"return per continuare ",x$
  650.  REM:IF x$=""THEN GOTO ilina ELSE GOSUB ultimo
  651.  GOSUB ultimo::GOSUB nw2:RETURN
  652. jlin:
  653.  CLS:INPUT "A=fondo blu ",wx$
  654.  IF UCASE$(wx$)="A" THEN PALETTE 1,.2,.3,1:COLOR 2,1:GOTO indice
  655.  PALETTE 1,1,1,1:COLOR 2,1:GOTO indice
  656.  SCREEN 2,640,250,2,2:GOTO jjlin
  657. jllin: 
  658.  PALETTE 1,.3,.2,1
  659.  SCREEN 2,640,500,2,4
  660. jjlin: 
  661.  WINDOW 2, "COGR" ,,8,2 
  662.  COLOR 2,1:GOTO indice
  663. REM:exclin   
  664. llin:
  665.  LIST:END
  666.  GOTO indice
  667. mlin:
  668.  CLS:OPEN"com1:1200,n,8,1" AS 1
  669. sera:
  670.  PRINT "Record n.";k%
  671.  oo$=INPUT$(9,1):PRINT oo$;" ";:cc$=INPUT$(25,1):PRINT cc$
  672.  LSET c$=cc$:RSET o$=oo$
  673.  PUT #4,k%:k%=(k%+1):GOSUB ultimo
  674.  GOTO sera
  675. nlin:
  676.  GOSUB nw1:INPUT"Record da cancellare  ";recc%
  677.  j%=recc%:GET #4,j%:GOSUB kas
  678.  FOR j%=recc% TO k%+1:GET #4,(j%+1):PUT #4,j%
  679.  NEXT j%:k%=k%-1
  680.  GOSUB nw2:RETURN
  681. olin:
  682.  CLS:INPUT"Record da duplicare ";j%:GET #4,j%:GOSUB kas:GOSUB corre:GOTO prosi
  683.  GOTO indice
  684. plin:
  685.  CLS:PRINT "scambio linee "
  686.  INPUT"1 linea ";aa%:INPUT"2 linea ";ab%
  687.  GET #4,aa%:PUT #4,(k%+2):GET #4,ab%:PUT #4,aa%
  688.  GET #4,(k%+2):PUT #4,ab%
  689.  GOTO indice
  690. qlin:
  691.  RUN
  692.  GOTO indice
  693. rlin:
  694.  SYSTEM
  695.  GOTO indice
  696. slin:
  697.  CLOSE:SAVE"df1:COMUA":RUN
  698. tlin:
  699.  CLS:INPUT"1=seriale on ",oua
  700.  INPUT"1=stampante on ",oub:IF oub=1 THEN GOSUB chef
  701.  INPUT"1=rosso on ",ouc
  702. tali:
  703.  INPUT"attrib sta ",x$:IF x$="" THEN GOTO indice
  704.  CLOSE #2:OPEN"PRT:" FOR OUTPUT AS #2
  705.  IF LEN(x$)>4 THEN PRINT #2,x$:CLOSE #2:GOTO tali
  706.  PRINT #2,CHR$(27)+"["+x$:CLOSE #2:GOTO tali 
  707.  GOTO indice 
  708. tempo:
  709.  gio$="          "+MID$(DATE$,4,2)+"/"+MID$(DATE$,1,2)+"/"+MID$(DATE$,7,10):PRINT gio$;"  ORE ";TIME$;" BAS";FRE(0);" MEM";FRE(-1);" Qso. no.";k%-1 
  710.  RETURN
  711. kss:
  712.  k$="LOG di I0GO, Giuseppe Riera, Via Tevere 15 Roma, Lic.1323 pat.1710 PAGINA n."+STR$(pgg):RETURN
  713. kssa:
  714.  k$="qso n. data e ora  Mhz modo   c a l l  mio suo      q t h     n o m e  fine":RETURN
  715. kssb:
  716.  k$="Potenze impiegate: 25W in VHF, 150W in HF. ore in CET    Firma:________________":RETURN
  717.  
  718. kas:  
  719.  mesi=VAL(MID$(d$,3,2)):IF mesi<>meso THEN GOSUB amese:meso=mesi
  720.  jj$=MID$((STR$(j%)),2):k$=SPACE$(4-LEN(jj$))+jj$+" "
  721.  k$=k$+MID$(d$,5,2)+"/"+MID$(d$,3,2)+"/"+MID$(d$,1,2)+" "+MID$(d$,7,4)
  722.  k$=k$+" "+o$+" "+c$+" "+r$+" "+q$+" "+n$+" "+f$
  723.  
  724.  GOSUB prs:GOSUB lpp
  725.  RETURN
  726. amese:
  727.  IF mesi > 12 THEN mesi=0
  728.  RETURN
  729.  k$="             ------ MESE DI "+mes$(mesi)+" 19"+MID$(d$,1,2)+" --------":GOSUB prs
  730.  RETURN
  731. prs:
  732.  REM:oucc=0:IF cco=1 AND ouc=1 THEN oucc=1
  733.  REM:IF MID$(k$,1,1)="=" OR MID$(k$,1,1)=" " THEN oucc=0
  734.  PRINT k$:IF oua=1 THEN CLOSE #1:OPEN"com1:1200,n,8,1,xon" AS #1:PRINT #1,k$ 
  735.  IF oub=1 AND oucc=1 THEN k$=CHR$(27)+"[35m"+k$+CHR$(27)+"[30m"
  736.  IF oub=1 THEN CLOSE #2:OPEN "PRT:" FOR OUTPUT AS #2:k$=CHR$(27)+"[3w"+CHR$(27)+"[2w"+CHR$(27)+"[0z"+k$:PRINT #2,k$:CLOSE #2
  737.  RETURN 
  738. indx:
  739.  INPUT"  premere RETURN per tornare all' indice  ",x$:GOTO indice
  740. lpp:
  741.   IF INKEY$="9"THEN GOTO plpp
  742.   RETURN
  743. plpp:
  744.   IF INPUT$(1)="8"THEN RETURN
  745.   IF INPUT$(1)="0"THEN GOTO indice
  746.   GOTO plpp
  747. wnd:
  748.   RETURN
  749.   WINDOW 4,"nouva",(1,1)-(100,100),15
  750.   WINDOW OUTPUT 4:RETURN
  751. wido:
  752.  w$=STR$(x#):w$=MID$(w$,2):le%=LEN(w$):FOR e%=le% TO 1 STEP(-1)
  753.  IF e%=le%-3 OR e%=le%-6 OR e%=le%-9 THEN LET w$=MID$(w$,1,e%)+"."+MID$(w$,(e%+1),(le%-e%+1))
  754.  NEXT e%:IF x#<0 THEN LET w$="-"+w$
  755.  RETURN          
  756. mese:
  757.  RESTORE mese
  758.  DIM mes$(12)
  759.  FOR j%=0 TO 12:READ mes$(j%)
  760.  NEXT j%
  761.  RETURN
  762.  DATA ?????,GENNAIO,FEBBRAIO,MARZO,APRILE
  763.  DATA MAGGIO,GIUGNO,LUGLIO,AGOSTO,SETTEMBRE
  764.  DATA OTTOBRE,NOVEMBRE,DICEMBRE  
  765. altro:
  766.   dt$=MID$(DATE$,9,2)+MID$(DATE$,1,2)+MID$(DATE$,4,2)
  767.   RETURN
  768. corre:  
  769.  INPUT"new data  ggmmaa ";dd$:IF dd$<>""THEN RSET d$=MID$(dd$,5,2)+MID$(dd$,3,2)+MID$(dd$,1,2)
  770.  PRINT "                   xxxxxxxxxxxxxxxxxxxxxxxxx"
  771.  INPUT"new causale      ";cc$:IF cc$<>""THEN LSET c$=UCASE$(cc$)
  772.  INPUT"new importo      ";oo$:IF oo$<>""THEN RSET o$=oo$
  773.  RETURN
  774. colo:
  775.  GOSUB altro
  776.  REM:COLOR 2,1:cco=0:IF d$>dt$ THEN COLOR 3,1:cco=1
  777.  RETURN
  778. c1:
  779.   COLOR 3:PRINT in$:COLOR 1:RETURN
  780.  
  781. chef:
  782.  IF oub=1 THEN INPUT"    ACCENDERE  LA STAMPANTE !!!!!!!  n=no ",wx$
  783.  IF UCASE$(wx$)="N" THEN oub=0
  784.  RETURN
  785. ultimo:
  786.  oo$="*":LSET o$=oo$:dd$="zzzzzz":LSET d$=dd$:PUT #4,k%:PUT #4,(k%+1)
  787.  RETURN
  788. nonce:
  789.  CLS:PRINT "Non vi sono record sufficienti nel file ";fi$
  790.  PRINT "per consentire l'ordinamento automatico in ordine di"
  791.  PRINT "data occorrono almeno 4 record (Da cancellare dopo)"
  792.  PRINT "che il computer inserisce automaticamente digitando una s"
  793.  INPUT"il solo return torna all'indice ",x$:IF UCASE$(x$)<>"S" THEN RETURN
  794.  FOR k%=1 TO 4 :LSET d$="800101":LSET c$="PROVA GR":RSET o$="0":PUT #4,k%
  795.  NEXT k%:GOSUB ultimo:j%=k%:RETURN
  796.  
  797.  
  798.  END
  799.  
  800.